perm filename DISKB.MAC[11,HE] blob sn#551873 filedate 1980-12-18 generic text, type T, neo UTF8
.TITLE DISK I/O TEST PROGRAM

.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBF$A,FDOP$A,FINIT$,FSRSZ$,OPEN$R,CLOSE$,GET$

        .BLKW 100                       ;Make some stack space
SPSTRT:

IOSTAT: .WORD 0,0                       ;Status for disk ops

RDSTS:  .WORD 0                         ;Read status block
RDCNT:  .WORD 0

WRSTS:  .WORD 0                         ;Write status block
        .BLKW 3                         ;Filler

FDB:    FDBDF$                          ;Make up the disk header info
;       FDAT$A  R.VAR,FD.CR
;       FDRC$A  ,RBUF,130.
;       FDOP$A  2,DATSET,,FO.RD
        FDBF$A
        FSRSZ$  1

RBUF:   .BLKB 512.

DATSET: .WORD 4,DEVNAM,9.,UIC,6,FILNAM
DEVNAM: .ASCII /DK0:/
UIC:    .ASCII /[200,200]/
FILNAM: .ASCII /FOO.;1/

BUFFER: .BLKB 82.

HIMES:  .ASCII /DISK RECORD PRINT PROGRAM/
HISIZE = .-HIMES
BYEMES: .ASCII /THAT'S IT/
BYESIZ = .-BYEMES
.EVEN

START:  MOV #SPSTRT,SP                  ;Set up stack???
        ALUN$S #1,#"TI,#0               ;LUN 1 is TI: device
        BCC 1$
        JMP ERROR                       ;Punt if error
1$:     QIOW$S #IO.ATT,#1,#1            ;Attach it
        BCC 2$
        JMP ERROR                       ;Punt if error
2$:     ALUN$S #2,#"DK,#0               ;LUN 2 is DK0:
        BCC 3$
        JMP ERROR                       ;Punt if error
3$:     QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#HIMES,#HISIZE,#40>      ;Say Hello
        BCC 4$
        JMP ERROR               ;Punt if error
4$:     FINIT$
        BCC 5$
        JMP ERROR
5$:     OPEN$R #FDB,#2,#DATSET,,#RBUF,#512.,ERROR
        MOV #BUFFER,R2
        MOV #RBUF,R1                    ;Get buffer address
        JSR PC,OUTNUM
        MOVB #40,(R2)+                  ;Append two spaces
        MOVB #40,(R2)+
        MOV F.FFBY+FDB,R1               ;Tell where the last record ends
        JSR PC,OUTNUM
        SUB #BUFFER,R2
        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40>  ;Type it out
        BCC 10$
        JMP ERROR                       ;Punt if error

10$:    GET$ #FDB,,,CKEOF               ;Read in the next record
        MOV #BUFFER,R2
        MOV F.NRBD(R0),R1               ;Get number of bytes read
        JSR PC,OUTNUM                   ;Print out record attribute bits
        MOVB #40,(R2)+                  ;Append two spaces
        MOVB #40,(R2)+
        MOV F.NRBD+2(R0),R1             ;Get address of buffer
        JSR PC,OUTNUM                   ;Print out record attribute bits
        SUB #BUFFER,R2
        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40>  ;Type it out
        BCS ERROR       ;Punt if error
        MOV F.NRBD(R0),R2               ;Get number of bytes read
        MOV F.NRBD+2(R0),R1             ;Get address of buffer
        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<R1,R2,#40>  ;Type it out
        BCS ERROR       ;Punt if error
        BR 10$

CKEOF:  CMPB #IE.EOF,F.ERR(R0)          ;Check if end of file
        BNE RDERR                       ;Punt if not
        CLOSE$ R0                       ;All done with file now
        BCS ERROR                       ;Punt if error

        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BYEMES,#BYESIZ,#60>  ;Say good bye
        BCS ERROR                       ;Punt if error

        EXIT$S ERROR                    ;Go away

        JMP START                       ;?????

RDERR:  MOV #BUFFER,R2
        MOVB #105,(R2)+                 ;"E "
        MOVB #40,(R2)+
        MOVB F.ERR(R0),R1               ;Get error condition number
        JSR PC,OUTNUM
        MOVB #40,(R2)+
        MOVB #40,(R2)+
        MOVB F.ERR+1(R0),R1             ;Get error number
        SUB #BUFFER,R2
        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40>  ;Type it out
ERROR:  MOV #BUFFER,R2
        MOVB #104,(R2)+                 ;"D "
        MOVB #40,(R2)+
        MOV $DSW,R1                     ;Get Directive Status Word too
        JSR PC,OUTNUM
        SUB #BUFFER,R2
        QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40>  ;Type it out
        IOT                             ;Crash if any errors


;Auxiliary routine to add the octal number in R1 to the buffer R2 points at

OUTNUM: MOV R0,-(SP)    ;We need some free registers
        MOV R1,-(SP)
        MOV R3,-(SP)
        CLR R0
        MOV #6,R3       ;6 digits to print
        ASHC #1,R0      ;Get high order digit
1$:     TST R0          ;Don't print leading zeros
        BNE 2$          ;Found highest order non-zero digit
        ASHC #3,R0      ;Try next
        SOB R3,1$
        INC R3
2$:     ADD #60,R0      ;Convert to ASCII
        MOVB R0,(R2)+   ;Stick it in buffer
        CLR R0
        ASHC #3,R0      ;Move on to next digit
        SOB R3,2$       ;Do them all
        MOV (SP)+,R3    ;Restore registers
        MOV (SP)+,R1
        MOV (SP)+,R0
        RTS PC

.END START